/* REXX _ip_checker.zrx by the reverend (build 85)                            */
/*-       built by rev-builder version 1.1 on 13 Nov 2002 at 16:54:55        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* description:  this script will munch your twgs log and sort all your users */
/*               by IP, giving you the aliases they use, and the games they   */
/*               are playing in.                                              */
/* rev. 0 - initial release                                                   */
/* rev. 1 - log date bug fix - now reads mm-dd-yyyy and mm/dd/yyyy            */

path="c:\program files\eis\twgs\"
infile=zocgetfilename("where is twgs log?",path||'*.log')
if infile="##CANCEL##" then exit

globals="ips. names. games. max wgames"
ips.=""
names.=""
games.=""
max=0
wgames=0
logname="iplog.txt"

if _fileopenr(infile) then do

 call _newline _ansi("bt;fwh")
 call zocwrite "reading "||infile||" "
 mon=_spinner(0,25)
 do while \_fileeof(infile)
  line=linein(infile)
  parse var line date time " - " cmd data
  if cmd="TRACE:" then do
   parse var data "Node" num "IP:" ip action name
   ip=_format_ip(ip)
   select
    when ip="Unknown" then nop
    when action="Name" then call addplayer ip, name
    when action="Enter" then call addgame ip, name
    otherwise nop
   end /*select*/
   mon=_spinner(mon,25)
  end /*if*/
 end /*do*/
 call _fileclose(infile)
 call zocwriteln

 call zocwrite "sorting "||max||" entries "
 mon=_progress(0,max)
 /* sort */
 do i=1 to max
  tag=i
  do j=i to max
   if ips.tag>ips.j then tag=j
  end /*do*/
  if tag>i then do
   temp=ips.i
   ips.i=ips.tag
   ips.tag=temp
   temp=names.i
   names.i=names.tag
   names.tag=temp
   temp=games.i
   games.i=games.tag
   games.tag=temp
  end /*if*/
  mon=_progress(mon,max)
 end /*do*/
 call zocwriteln

 /* report */
 parse value _getloginfo() with lpath ";" ldefault
 if zocgetinfo("VERSION")>=4.03 then call zoclogging 0, 1
 else call zoclogging 0
 call zoclogname logname
 if zocgetinfo("VERSION")>=4.03 then call zoclogging 1, 1
 else call zoclogging 1

 call zocwriteln
 call zocwriteln "REV-SCRIPT - "||infile||", "||date("N")||", "||time("N")
 do i=1 to max
  call zocwriteln ips.i||" - "||games.i||copies(" ",wgames-length(games.i))||" - "||names.i
 end /*do*/

 if zocgetinfo("VERSION")>=4.03 then call zoclogging 0, 1
 else call zoclogging 0
 call zoclogname ldefault
 if zocgetinfo("VERSION")>=4.03 then call zoclogging 1, 1
 else call zoclogging 1

end /*if*/
else call zocwriteln "unable to open "||infile

exit

addplayer: procedure expose (globals)
 ip=arg(1)
 player=arg(2)
 done=0
 found=0
 i=1
 do while \done
  select
   when ips.i="" then done=1
   when ip=ips.i then do
    found=1
    done=1
   end /*when*/
   otherwise i=i+1
  end /*select*/
 end /*do*/
 if found then do
  if \_listin(player,names.i) then do
   if names.i="" then names.i=player
   else do
    names.i=names.i||";"||player
    names.i=_listsort(names.i)
   end /*else*/
  end /*if*/
 end /*if*/
 else do
  max=max(max,i)
  ips.i=ip
  names.i=player
 end /*else*/
return

addgame:
 ip=arg(1)
 game=right(arg(2),1)
 done=0
 found=0
 i=1
 do while \done
  select
   when ips.i="" then done=1
   when ip=ips.i then do
    found=1
    done=1
   end /*when*/
   otherwise i=i+1
  end /*select*/
 end /*do*/
 if found then do
  if \_in(games.i,game) then do
   if games.i="" then games.i=game
   else games.i=_sort_string(games.i||game)
   wgames=max(wgames,length(games.i))
  end /*if*/
 end /*if*/
 else do
  max=max(max,i)
  ips.i=ip
  games.i=game
 end /*else*/
return

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _fileopenr v.4 **/
    _fileopenr: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenr"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN READ"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=0
    return rslt

/** _newline v.2 **/
    _newline: procedure expose (globals)
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1)
     else call zocwrite arg(1)
    return

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _spinner v.3 **/
    _spinner: procedure expose (globals)
     if arg(1,"E") then count=arg(1)
                   else call _error "missing parameter in _spinner"
     if arg(2,"E") then width=arg(2)
                   else width=100
     if arg(3,"E") & length(arg(3))=5 then chs=arg(3)
                                      else chs="-\|/."
    /* bs="^H" */
     bs=d2c(27)||"[1D"
     select
      when count=-1        then call zocwrite bs||substr(chs,5,1)
      when count<0         then count=-1
      when count=0         then call zocwrite left(chs,1)
      when count=width     then call zocwrite bs||substr(chs,2,1)
      when count=(width*2) then call zocwrite bs||substr(chs,3,1)
      when count=(width*3) then call zocwrite bs||substr(chs,4,1)
      when count=(width*4) then do
       call zocwrite bs||left(chs,1)
       count=0
      end /*when*/
      otherwise nop
     end /*select*/
     count=count+1
    return count

/** _fileeof v.4 **/
    _fileeof: procedure expose (globals)
     rslt=\lines(arg(1))
    return rslt

/** _format_ip v.2 **/
    _format_ip: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _format_ip"
     rslt=""
     ip=strip(translate(arg(1)," ","."))
     c=words(ip)
     if c<4 then rslt=""
     else do
      do i=1 to c
       temp=word(ip,i)
       rslt=rslt||" "||copies("0",3-length(temp))||temp
      end /*do*/
      rslt=translate(strip(rslt),"."," ")
     end /*else*/
    return rslt

/** _fileclose v.3 **/
    _fileclose: procedure expose (globals)
     if \arg(1,"E") then call _error "missing argument in _fileclose"
     call stream arg(1), "C", "CLOSE"
    return

/** _progress v.3 **/
    _progress: procedure expose (globals)
     count=arg(1)
     max=arg(2)
     select
      when count=0 then call zocwrite "[     0%   ]"
      when count=max then call zocwrite d2c(27)||"[12D[***100%***]"
      otherwise do
       if trunc(count*100/max)>trunc((count-1)*100/max) then do
        i=(count*100)%max
        call zocwrite d2c(27)||"[12D["
        select
         when i>=30 then call zocwrite "***"
         when i>=20 then call zocwrite "** "
         when i>=10 then call zocwrite "*  "
         otherwise call zocwrite "   "
        end /*select*/
        select
         when i=100 then call zocwrite i||"%"
         when i>=40 then call zocwrite "*"||i||"%"
         when i>=10 then call zocwrite " "||i||"%"
         otherwise call zocwrite "  "||i||"%"
        end /*select*/
        select
         when i=100 then call zocwrite "***"
         when i>=90 then call zocwrite "** "
         when i>=80 then call zocwrite "*  "
         otherwise call zocwrite "   "
        end /*select*/
        call zocwrite "]"
       end /*if*/
      end /*otherwise*/
     end /*select*/
     count=count+1
    return count

/** _getloginfo v.2 **/
    _getloginfo: procedure expose (globals)
     parse value zocgetoption("CaptDefaultName") with . '="' ldefault '"'
     parse value zocgetglobaloption("CapturePath") with . '="' lpath '"'
     lpath=dosfname(lpath)
     if right(lpath,1)\="\" then lpath=lpath||"\"
     if \dosisdir(lpath) then call _error "invalid path in _getloginfo"
     rslt=lpath||";"||ldefault
    return rslt

/** _listin v.3 **/
    _listin: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _listin"
     find=arg(1)
     list=arg(2)
     if arg(3,"E") then delim=left(arg(3),1)
                   else delim=";"
     rslt=0
     do i=1 to _dwords(list,delim)
      if find==_dword(list,i,delim) then do
       rslt=1
       leave
      end /*if*/
     end /*do*/
    return rslt

/** _listsort v.3 **/
    _listsort: procedure expose (globals)
     list=arg(1)
     if arg(2,"E") then delim=arg(2)
                   else delim=";"
     a.=""
     do i=1 to _dwords(list,delim)
      a.i=_dword(list,i,delim)
     end /*do*/
     do k=i-1 to 1 by -1
      do j= 1 to k
       j2=j+1
       if a.j>a.j2 then do
        temp=a.j
        a.j=a.j2
        a.j2=temp
       end /*if*/
      end /*do*/
     end /*do*/
     list=a.1
     i=2
     do while a.i\=""
      if list="" then list=a.i
      else list=list||delim||a.i
      i=i+1
     end /*do*/
    return list

/** _in v.3 **/
    _in: procedure expose (globals)
     if arg(1,"E") & arg(2,"E") & length(arg(1))>0 & verify(arg(2),arg(1),"N")=0 then rslt=1
     else rslt=0
    return rslt

/** _sort_string v.1 **/
    _sort_string: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _sort_string"
     ch.0=length(arg(1))
     do i=1 to ch.0
      ch.i=substr(arg(1),i,1)
     end /*do*/
     do i=1 to ch.0
      do j=i to ch.0
       if ch.i>ch.j then do
        temp=ch.i
        ch.i=ch.j
        ch.j=temp
       end /*if*/
      end /*do*/
     end /*do*/
     rslt=""
     do i=1 to ch.0
      rslt=rslt||ch.i
     end /*do*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt

/** _fileready v.1 **/
    _fileready: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileready"
     if stream(arg(1), "S")="READY" then rslt=1; else rslt=0
    return rslt

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return